﻿Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
Imports System.Runtime.CompilerServices

Module GraphicExtensions

    <Extension()> _
    Function Resize(ByVal Image As Image, ByVal x As Integer, ByVal y As Integer, Optional ByVal m As Integer = 0) As Image
        Dim NewImage As New Bitmap(x, y)
        Dim G As Graphics = Graphics.FromImage(NewImage)
        G.InterpolationMode = Drawing2D.InterpolationMode.High
        G.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
        G.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
        G.DrawImage(Image, New Rectangle(m, m, x - m * 2, y - m * 2), New Rectangle(0, 0, Image.Width, Image.Height), GraphicsUnit.Pixel)
        Return NewImage
    End Function

    <Extension()> _
    Function Combine(ByVal NewImage As Image, ByVal Image As Image, ByVal x As Integer, ByVal y As Integer, Optional ByVal m As Integer = 0, Optional ByVal ox As Integer = 0, Optional ByVal oy As Integer = 0) As Image
        Dim G As Graphics = Graphics.FromImage(NewImage)
        G.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
        G.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
        G.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
        G.DrawImage(Image, New Rectangle(m + ox, m + oy, x - m * 2, y - m * 2), New Rectangle(0, 0, Image.Width, Image.Height), GraphicsUnit.Pixel)
        Return NewImage
    End Function

    <Extension()> _
    Public Sub DrawRoundRect(ByVal Gr As Graphics, ByVal Rect As Rectangle, ByVal Pen As Pen, ByVal ArcSize As Integer, ByVal Borders As String)
        If ArcSize = 0 Then
            Gr.DrawRectangle(Pen, Rect)
            Exit Sub
        End If
        Dim Path As GraphicsPath = RoundRectPath(Rect, ArcSize, Borders)
        Gr.DrawPath(Pen, Path)
    End Sub

    <Extension()> _
    Public Sub DrawRoundRect(ByVal Gr As Graphics, ByVal Rect As Rectangle, ByVal Pen As Pen, ByVal ArcSize As Integer)
        DrawRoundRect(Gr, Rect, Pen, ArcSize, "tlbr")
    End Sub

    <Extension()> _
    Public Sub FillRoundRect(ByVal Gr As Graphics, ByVal Rect As Rectangle, ByVal Brush As Brush, ByVal ArcSize As Integer)
        Dim Path As GraphicsPath = RoundRectPath(Rect, ArcSize, "tlbr")
        Gr.FillPath(Brush, Path)
    End Sub

    <Extension()> _
    Public Sub FillRoundRect(ByVal Gr As Graphics, ByVal Rect As Rectangle, ByVal Brush As Brush, ByVal ArcTL As Integer, ByVal ArcTR As Integer, ByVal ArcBR As Integer, ByVal ArcBL As Integer)
        Dim Path As GraphicsPath = RoundRectPath(Rect, ArcTL, ArcTR, ArcBR, ArcBL)
        Gr.FillPath(Brush, Path)
    End Sub

    <Extension()> _
    Sub SaveJpeg(ByVal Image As Image, ByVal Path As String, ByVal Quality As Long, Optional ByVal Overwrite As Boolean = False)
        Dim QualityParam As New EncoderParameter(Encoder.Quality, Quality)
        Dim JpegCodec As ImageCodecInfo = GetEncoderInfo("image/jpeg")
        Dim EncoderParams As New EncoderParameters(1)
        EncoderParams.Param(0) = QualityParam
        If Overwrite AndAlso My.Computer.FileSystem.FileExists(Path) Then My.Computer.FileSystem.DeleteFile(Path)
        Image.Save(Path, JpegCodec, EncoderParams)
    End Sub

    Function GetEncoderInfo(ByVal MimeType As String) As ImageCodecInfo
        Dim Codecs As ImageCodecInfo() = ImageCodecInfo.GetImageEncoders()
        For i As Integer = 0 To Codecs.Length - 1
            If (Codecs(i).MimeType = MimeType) Then Return Codecs(i)
        Next i
        Return Nothing
    End Function

    Function RoundRectPath(ByVal Rect As Rectangle, ByVal ArcSize As Integer, ByVal Borders As String) As GraphicsPath
        Dim Path As New GraphicsPath
        With Path
            .StartFigure()
            Dim Bottom As Integer = Rect.Bottom - ArcSize - 1
            Dim Right As Integer = Rect.Right - ArcSize - 1
            If Len(Borders) = 4 Then
                .AddArc(New Rectangle(Rect.X, Rect.Y, ArcSize, ArcSize), 180, 90)
                .AddArc(New Rectangle(Right, Rect.Y, ArcSize + 1, ArcSize), 270, 90)
                .AddArc(New Rectangle(Right, Bottom, ArcSize + 1, ArcSize + 1), 0, 90)
                .AddArc(New Rectangle(Rect.X, Bottom, ArcSize, ArcSize + 1), 90, 90)
                .CloseFigure()
            Else
                Select Case Borders
                    Case "tl", "lt"
                        .AddArc(New Rectangle(Rect.X, Bottom, ArcSize, ArcSize), 135, 45)
                        .AddArc(New Rectangle(Rect.X, Rect.Y, ArcSize, ArcSize), 180, 90)
                        .AddArc(New Rectangle(Right, Rect.Y, ArcSize, ArcSize), 270, 45)
                    Case "br", "rb"
                        .AddArc(New Rectangle(Right, Rect.Y, ArcSize, ArcSize), 315, 45)
                        .AddArc(New Rectangle(Right, Bottom, ArcSize, ArcSize), 0, 90)
                        .AddArc(New Rectangle(Rect.X, Bottom, ArcSize, ArcSize), 90, 45)
                End Select
            End If
        End With
        Return Path
    End Function

    Function RoundRectPath(ByVal Rect As Rectangle, ByVal ArcTL As Integer, ByVal ArcTR As Integer, ByVal ArcBR As Integer, ByVal ArcBL As Integer) As GraphicsPath
        Dim Path As New GraphicsPath
        With Path
            .StartFigure()
            .AddArc(New Rectangle(Rect.X, Rect.Y, ArcTL, ArcTL), 180, 90)
            .AddArc(New Rectangle(Rect.Right - ArcTR, Rect.Y, ArcTR, ArcTR), 270, 90)
            .AddArc(New Rectangle(Rect.Right - ArcBR, Rect.Bottom - ArcBR, ArcBR, ArcBR), 0, 90)
            .AddArc(New Rectangle(Rect.X, Rect.Bottom - ArcBL, ArcBL, ArcBL), 90, 90)
            .CloseFigure()
        End With
        Return Path
    End Function

    <Extension()> _
    Function Whiten(ByVal c As Color, ByVal r As Double) As Color
        Return Color.FromArgb(c.R * (1 - r) + 255 * r, c.G * (1 - r) + 255 * r, c.B * (1 - r) + 255 * r)
    End Function
    <Extension()> _
    Function Blacken(ByVal c As Color, ByVal r As Double) As Color
        Return Color.FromArgb(c.R * (1 - r), c.G * (1 - r), c.B * (1 - r))
    End Function

    Public Function LGBv(ByVal Rect As Rectangle, ByVal Color1 As Color, ByVal Color2 As Color) As LinearGradientBrush
        Return New LinearGradientBrush(Rect, Color1, Color2, LinearGradientMode.Vertical)
    End Function

    Public Function LGBh(ByVal Rect As Rectangle, ByVal Color1 As Color, ByVal Color2 As Color) As LinearGradientBrush
        Return New LinearGradientBrush(Rect, Color1, Color2, LinearGradientMode.Horizontal)
    End Function

    Public Function LGBd(ByVal Rect As Rectangle, ByVal Color1 As Color, ByVal Color2 As Color) As LinearGradientBrush
        Return New LinearGradientBrush(Rect, Color1, Color2, LinearGradientMode.ForwardDiagonal)
    End Function

    <Extension()> _
    Sub DrawImageWithOpacity(ByVal G As Graphics, ByVal B As Image, ByVal DestRect As Rectangle, Optional ByVal Opacity As Single = 1)
        G.InterpolationMode = InterpolationMode.HighQualityBicubic
        G.PixelOffsetMode = PixelOffsetMode.HighQuality
        Dim Attr As New Imaging.ImageAttributes
        Dim Matrix As New Imaging.ColorMatrix(New Single()() {New Single() {1, 0, 0, 0, 0}, New Single() {0, 1, 0, 0, 0}, New Single() {0, 0, 1, 0, 0}, New Single() {0, 0, 0, Opacity, 0}, New Single() {0, 0, 0, 0, 1}})
        Attr.SetColorMatrix(Matrix)
        If B Is Nothing Then Exit Sub
        G.DrawImage(B, DestRect, 0, 0, B.Width, B.Height, GraphicsUnit.Pixel, Attr)
    End Sub

    <Extension()> _
    Sub DrawFocusRect(ByVal G As Graphics, ByVal R As Rectangle, ByVal IsSelected As Boolean, ByVal IsHot As Boolean, ByVal IsDropTarget As Boolean, ByVal IsFocused As Boolean, ByVal ControlFocus As Boolean)
        G.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
        G.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
        G.PixelOffsetMode = Drawing2D.PixelOffsetMode.None
        Dim Alpha As Double = If(IsSelected, 1, If(IsHot, 0.4, If(IsDropTarget, 1, 0)))
        Dim Col As Color = SystemColors.Highlight
        If IsDropTarget Then Col = SystemColors.HotTrack
        If Not ControlFocus And Not IsHot And Not IsDropTarget Then Col = SystemColors.ButtonShadow
        If Alpha > 0 Then
            FillRoundRect(G, R, Brushes.White, 5)
            FillRoundRect(G, R, LGBv(R, Color.FromArgb(16 * Alpha, Col), Color.FromArgb(128 * Alpha, Col)), 5)
        End If
        If Alpha > 0 Or IsFocused Then
            'R.Width -= 1 : R.Height -= 1
            DrawRoundRect(G, R, New Pen(Color.FromArgb(255 * If(IsFocused, 1, Alpha), Col)), 4)
            R.Inflate(-1, -1)
            DrawRoundRect(G, R, New Pen(Color.FromArgb(64, Color.White)), 3)
        End If
    End Sub

    <Extension()> _
    Sub DrawStringBordered(ByVal G As Graphics, ByVal Text As String, ByVal Font As Font, ByVal Rect As Rectangle, ByVal BorderColor As Color, ByVal TextColor As Color)
        For x As Integer = -1 To 1
            For y As Integer = -1 To 1
                Dim R As Rectangle = Rect
                R.Offset(x, y)
                G.DrawString(Text, Font, New SolidBrush(BorderColor), R)
            Next
        Next
        G.DrawString(Text, Font, New SolidBrush(TextColor), Rect)
    End Sub

    <Extension()> _
    Function Disabled(ByVal Image As Image) As Image
        Dim Bitmap As New Bitmap(Image)
        For x As Integer = 0 To Bitmap.Width - 1
            For y As Integer = 0 To Bitmap.Height - 1
                Dim Col As Color = Bitmap.GetPixel(x, y)
                Dim g As Integer = (Col.R / 3 + Col.G / 3 + Col.B / 3)
                Dim d As Integer = Math.Abs(g - 128) * 3 / 4 + 32
                'Bitmap.SetPixel(x, y, Color.FromArgb((Col.A * Math.Abs((g - 128) / 160) ^ 0.5), g, g, g))
                Bitmap.SetPixel(x, y, Color.FromArgb(Col.A / 255 * d, g, g, g))
            Next
        Next
        Return Bitmap
    End Function

    <Extension()> _
    Function Selected(ByVal Image As Image) As Image
        Dim Bitmap As New Bitmap(Image)
        For x As Integer = 0 To Bitmap.Width - 1
            For y As Integer = 0 To Bitmap.Height - 1
                Dim Col As Color = Bitmap.GetPixel(x, y)
                Bitmap.SetPixel(x, y, Color.FromArgb(Col.A, (Col.R / 255) ^ 0.5 * 255, (Col.G / 255) ^ 0.5 * 255, (Col.B / 255) ^ 0.5 * 255))
            Next
        Next
        Return Bitmap
    End Function

    <Extension()> _
    Function Pressed(ByVal Image As Image) As Image
        Dim Bitmap As New Bitmap(Image)
        For x As Integer = 0 To Bitmap.Width - 1
            For y As Integer = 0 To Bitmap.Height - 1
                Dim Col As Color = Bitmap.GetPixel(x, y)
                Bitmap.SetPixel(x, y, Color.FromArgb(Col.A, (Col.R / 255) ^ 2 * 255, (Col.G / 255) ^ 2 * 255, (Col.B / 255) ^ 2 * 255))
            Next
        Next
        Return Bitmap
    End Function

    <Extension()> _
    Function A(ByVal Pen As Pen, ByVal Opacity As Double) As Pen
        Return New Pen(Color.FromArgb(255 * Opacity, Pen.Color))
    End Function

    <Extension()> _
    Function A(ByVal Brush As Brush, ByVal Opacity As Double) As SolidBrush
        Return New SolidBrush(Color.FromArgb(255 * Opacity, CType(Brush, SolidBrush).Color))
    End Function

    <Extension()> _
    Function A(ByVal Brush As SolidBrush, ByVal R As Rectangle, ByVal Opacity1 As Double, ByVal Opacity2 As Double, ByVal d As String) As LinearGradientBrush
        Return New LinearGradientBrush(R, Color.FromArgb(255 * Opacity1, Brush.Color), Color.FromArgb(255 * Opacity2, Brush.Color), If(d = "v", 0, 90))
    End Function

    <Extension()> _
    Sub AddLines(ByVal Path As GraphicsPath, ByVal ParamArray xy() As Double)
        Dim Points As New List(Of Point)
        For i As Integer = 0 To xy.Length - 1 Step 2
            Points.Add(New Point(xy(i), xy(i + 1)))
        Next
        Path.AddLines(Points.ToArray)
    End Sub

    <Extension()> _
    Sub DrawShadow(ByVal Gr As Graphics, ByVal R As Rectangle)
        Dim Shadow As New Bitmap(R.Width \ 4, R.Height \ 4)
        Dim h As Graphics = Graphics.FromImage(Shadow)
        h.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
        h.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
        h.FillRectangle(New SolidBrush(Color.FromArgb(144, Color.Black)), New Rectangle(1, 1, Shadow.Width - 2, Shadow.Height - 2))
        Gr.DrawImage(Shadow, R)
        h.Dispose()
        Shadow.Dispose()
    End Sub

End Module

Module StringExtensions

    <Extension()> _
    Function Parse(ByVal s As String, ByVal Item As String) As String
        Dim Pos As Integer = InStr(s, vbTab & Item & "=")
        If Pos = 0 Then Return ""
        s = Mid(s, Pos + Len(Item) + 2)
        Pos = InStr(s & vbTab, vbTab)
        Return Mid(s, 1, Pos - 1)
    End Function

    <Extension()> _
    Function Mid(s As String, Start As Integer, Length As Integer) As String
        Return Strings.Mid(s, Start, Length)
    End Function

    <Extension()> _
    Function Mid(s As String, Start As Integer) As String
        Return Strings.Mid(s, Start)
    End Function

    <Extension()> _
    Function Right(s As String, Start As Integer) As String
        Return Strings.Right(s, Start)
    End Function

End Module

Module ToolstripExtensions

        <Extension()> _
        Public Function Clone(ByVal m As ToolStripMenuItem) As ToolStripMenuItem
            Dim Menu As New ToolStripMenuItem
            Menu.Text = m.Text
            Menu.Image = m.Image
            AddHandler Menu.Click, AddressOf m.PerformClick
            For Each SubItem In m.DropDownItems
                If TypeOf SubItem Is ToolStripMenuItem Then
                    Menu.DropDownItems.Add(Clone(SubItem))
                ElseIf TypeOf SubItem Is ToolStripSeparator Then
                    Menu.DropDownItems.Add("-")
                End If
            Next
            Return Menu
        End Function

        <Extension()> _
        Public Sub AddClones(ByVal c As ContextMenuStrip, ByVal ParamArray MenuItems() As Object)
            For Each Item As Object In MenuItems
                If TypeOf Item Is String AndAlso Item = "-" Then
                    c.Items.Add("-")
                Else
                    c.Items.Add(Clone(Item))
                End If
            Next
        End Sub


        <Extension()> _
        Public Function Clone(ByVal m As ToolStripSplitButton) As ToolStripMenuItem
            Dim Menu As New ToolStripMenuItem
            Menu.Text = m.Text
            Menu.Image = m.Image
            AddHandler Menu.Click, AddressOf m.PerformClick
            For Each SubItem In m.DropDownItems
                If TypeOf SubItem Is ToolStripMenuItem Then
                    Menu.DropDownItems.Add(Clone(SubItem))
                ElseIf TypeOf SubItem Is ToolStripSeparator Then
                    Menu.DropDownItems.Add("-")
                End If
            Next
            Return Menu
        End Function

        <Extension()> _
        Public Function Clone(ByVal m As ToolStripDropDownButton) As ToolStripMenuItem
            Dim Menu As New ToolStripMenuItem
            Menu.Text = m.Text
            Menu.Image = m.Image
            AddHandler Menu.Click, AddressOf m.PerformClick
            For Each SubItem In m.DropDownItems
                If TypeOf SubItem Is ToolStripMenuItem Then
                    Menu.DropDownItems.Add(Clone(SubItem))
                ElseIf TypeOf SubItem Is ToolStripSeparator Then
                    Menu.DropDownItems.Add("-")
                End If
            Next
            Return Menu
        End Function

End Module

Module FileExtensions

    <Extension()> _
    Function Find(ByVal Folder As String, ByVal Expr As String) As List(Of String)
        Dim Found As New List(Of String)
        Try
            For Each Item In My.Computer.FileSystem.GetFiles(Folder, FileIO.SearchOption.SearchTopLevelOnly, Expr)
                Found.Add(Item)
            Next
        Catch ex As Exception
        End Try
        Try
            For Each Item In My.Computer.FileSystem.GetDirectories(Folder, FileIO.SearchOption.SearchTopLevelOnly)
                Dim SubFound = Item.Find(Expr)
                If SubFound.Count > 0 Then Found.AddRange(SubFound)
            Next
        Catch ex As Exception
        End Try
        Return Found
    End Function

    <Extension()>
    Function Exists(ByVal File As String) As Boolean
        Return My.Computer.FileSystem.FileExists(File)
    End Function

End Module